Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/toolkit/vbof_v11/demoprsn.cls

Text File | 1996-03-01 | 17.8 KB | 647 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Person"
Attribute VB_Creatable = False
Attribute VB_Exposed = True
Option Explicit

' the following pertain to being supported by
'   VBOFCollection, VBOFObjectManager and
'   VBOFEventManager
Public ObjectID As Long
Public ObjectChanged As Long
Public ObjectAdded As Long
Public ObjectDeleted As Long
Public ObjectParentCount As Long
Public ObjectManager As VBOFObjectManager

' the following code pertains to the business
'   of the Person object
Private pvtCustomerNumber As Long
Private pvtFirstName As String
Private pvtLastName As String
Private pvtMaidenName As String
Private pvtSSN As Long
Private pvtSex As String
Private pvtDateOfBirth As Variant
Private pvtDateOfDeath As Variant
Private pvtMaritalStatus As String
Private pvtAddressesCollection As VBOFCollection
Private pvtPhonesCollection As VBOFCollection
Private pvtMother As Person
Private pvtFather As Person
Private pvtSpouse As Person

Public Function ObjectSortCompare(Optional SortField As Variant, Optional SortOrder As Variant, Optional CompareObject As Variant) As Long
' Support the Collection.Sort method
' Note: use the ObjectManager.ObjectSortCompare
'   method for assistance

    On Local Error Resume Next

    Select Case SortField
        Case "FirstName"
            ObjectSortCompare = _
                ObjectManager.ObjectSortCompare( _
                    Value1:=FirstName, _
                    Value2:=CompareObject.FirstName, _
                    SortOrder:=SortOrder)

        Case "LastName"
            ObjectSortCompare = _
                ObjectManager.ObjectSortCompare( _
                    Value1:=LastName, _
                    Value2:=CompareObject.LastName, _
                    SortOrder:=SortOrder)

        Case "FormattedName"
            ObjectSortCompare = _
                ObjectManager.ObjectSortCompare( _
                    Value1:=FormattedName, _
                    Value2:=CompareObject.FormattedName, _
                    SortOrder:=SortOrder)

        Case "DateOfBirth"
            ObjectSortCompare = _
                ObjectManager.ObjectSortCompare( _
                    Value1:=Format$(DateOfBirth, "yyyy/mm/dd"), _
                    Value2:=Format$(CompareObject.DateOfBirth, "yyyy/mm/dd"), _
                    SortOrder:=SortOrder)

        Case "DateOfDeath"
            ObjectSortCompare = _
                ObjectManager.ObjectSortCompare( _
                    Value1:=Format$(DateOfDeath, "yyyy/mm/dd"), _
                    Value2:=Format$(CompareObject.DateOfDeath, "yyyy/mm/dd"), _
                    SortOrder:=SortOrder)

        Case "SpouseFormattedName"
            ObjectSortCompare = _
                ObjectManager.ObjectSortCompare( _
                    Value1:=Spouse.FormattedName, _
                    Value2:=CompareObject.Spouse.FormattedName, _
                    SortOrder:=SortOrder)
    End Select

End Function


Public Property Set Father(aPerson As Variant)
    Set pvtFather = aPerson
End Property

Public Property Set Spouse(aPerson As Variant)
    Set pvtSpouse = aPerson
End Property


Public Property Get Father() As Variant
    Set Father = pvtFather
End Property

Public Property Get Spouse() As Variant
    Set Spouse = pvtSpouse
End Property


Public Property Set Mother(aPerson As Variant)
    Set pvtMother = aPerson
End Property

Public Property Get Mother() As Variant
    Set Mother = pvtMother
End Property


Public Function ObjectDBGridUnboundReadData(Optional DBGrid As Variant, Optional RowBuf As Variant, Optional RowNumber As Variant) As Boolean
' Populate the DBGrid RowBuf with values from
'   variables within this object
'   (in support of VBOFCollection)
' Parameter Description:
'   DBGrid:= the DBGrid which is being
'       populated
'   RowBuf:= the current DBGrid RowBuf object
'   RowNumber:= the row number being processed

    Dim I As Long

    For I = 0 To RowBuf.ColumnCount - 1
        Select Case RowBuf.ColumnName(I)
            Case "CustomerNumber"
                RowBuf.Value(RowNumber, I) = CustomerNumber
            Case "FirstName"
                RowBuf.Value(RowNumber, I) = FirstName
            Case "LastName"
                RowBuf.Value(RowNumber, I) = LastName
            Case "MaidenName"
                RowBuf.Value(RowNumber, I) = MaidenName
            Case "SSN"
                RowBuf.Value(RowNumber, I) = SSN
            Case "Sex"
                RowBuf.Value(RowNumber, I) = Sex
            Case "DateOfBirth"
                RowBuf.Value(RowNumber, I) = DateOfBirth
            Case "DateOfDeath"
                RowBuf.Value(RowNumber, I) = DateOfDeath
            Case "MaritalStatus"
                RowBuf.Value(RowNumber, I) = MaritalStatus
            Case "ObjectID"
                RowBuf.Value(RowNumber, I) = ObjectID
        End Select
    Next I

End Function
Public Function ObjectDBGridUnboundAddData(Optional DBGrid As Variant, Optional RowBuf As Variant, Optional NewRowBookmark As Variant) As Boolean
' Populate the object variables with the values
'   provided by the user in the new row of the
'   DBGrid
'   (in support of VBOFCollection)
'
' Parameter Description:
'   DBGrid:= the DBGrid which is being
'       populated
'   RowBuf:= the current DBGrid RowBuf object
'   NewRowBookmark:= the row number being processed

    Dim I As Long

    For I = 0 To RowBuf.ColumnCount - 1
        If Not IsNull(RowBuf.Value(0, I)) Then
            Select Case RowBuf.ColumnName(I)
                Case "CustomerNumber"
                    CustomerNumber = RowBuf.Value(0, I)
                Case "FirstName"
                    FirstName = RowBuf.Value(0, I)
                Case "LastName"
                    LastName = RowBuf.Value(0, I)
                Case "MaidenName"
                    MaidenName = RowBuf.Value(0, I)
                Case "SSN"
                    SSN = RowBuf.Value(0, I)
                Case "Sex"
                    Sex = RowBuf.Value(0, I)
                Case "DateOfBirth"
                    DateOfBirth = RowBuf.Value(0, I)
                Case "DateOfDeath"
                    DateOfDeath = RowBuf.Value(0, I)
                Case "MaritalStatus"
                    MaritalStatus = RowBuf.Value(0, I)

' Note:  Do not initialize the ObjectID.

            End Select
        End If
    Next I

' return "OK" status
    ObjectDBGridUnboundAddData = True
End Function


Public Function ObjectListBoxValue() As String
' Return a String will represent this object
'   in a ListBox
'   (in support of VBOFCollection)

    ObjectListBoxValue = _
        FormattedName

End Function

Public Function PersonalInformation() As String
' Returns a string containing the formatted names
'   of this person's parents or spouse

    Dim ReturnString As String

    If pvtMother Is Nothing _
    And pvtFather Is Nothing _
    And pvtSpouse Is Nothing _
    Then
        PersonalInformation = "There is no known lineage for this person"
        Exit Function
    End If

    ReturnString = "Personal Info: "

    If Not pvtMother Is Nothing Then
        ReturnString = ReturnString & _
            " Mother: " & _
            pvtMother.FormattedName
    End If

    If Not pvtFather Is Nothing Then
        ReturnString = ReturnString & _
            " Father: " & _
            pvtFather.FormattedName
    End If

    If Not pvtSpouse Is Nothing Then
        ReturnString = ReturnString & _
            " Spouse: " & _
            pvtSpouse.FormattedName
    End If

    PersonalInformation = ReturnString
End Function

Private Sub Class_Terminate()
    If Not ObjectManager Is Nothing Then
        ObjectManager.TerminateObject _
            Object:=Me
    End If
End Sub


Public Function ObjectHasChanged()
' Mark this object as "Changed" and trigger the
'   "Changed" event
' Note: if processing in SynchronousCommit mode,
'   it might be advisable to execute this method
'   after any of the application's properties have
'   changed.  Otherwise, it might be best to have
'   the application GUI execute this method after
'   posting a series of property changes.

    ObjectChanged = True

#If NoEventMgr = False Then
    If Not ObjectManager Is Nothing Then
        ObjectManager. _
            TriggerObjectEvent _
                Event:="Changed", _
                Object:=Me
    End If
#End If

End Function

Public Function AddPhone(Optional Item As Variant, Optional Parent As Variant) As Phone
' Return a Phone, added to my pvtPhonesCollection
'   (just a wrapper method for Phones.Add)

    Set AddPhone = Me.Phones.Add( _
        Item:=Item, _
        Parent:=Me)

    ObjectHasChanged
End Function

Public Function ObjectInitializeFromRecordSet(Optional RecordSet As Variant) As Person
' Populate my variables from the RecordSet
'   (in support of VBOFCollection)

    Dim NewPerson As New Person

    On Local Error Resume Next

    CustomerNumber = RecordSet("CustomerNumber")
    FirstName = RecordSet("FirstName")
    LastName = RecordSet("LastName")
    SSN = RecordSet("SSN")
    Sex = RecordSet("Sex")
    If IsNull(RecordSet("DateOfBirth")) Then
        DateOfBirth = #1/1/01#
    Else
        DateOfBirth = RecordSet("DateOfBirth")
    End If
    If IsNull(RecordSet("DateOfDeath")) Then
        DateOfDeath = #1/1/01#
    Else
        DateOfDeath = RecordSet("DateOfDeath")
    End If
    MaritalStatus = RecordSet("MaritalStatus")
    MaidenName = RecordSet("MaidenName")

    ObjectID = RecordSet("ObjectID")

' pick-up the Mother object
    If Not IsNull(RecordSet("MotherObjectID")) Then
        Set pvtMother = _
            ObjectManager. _
                NewObject( _
                    Sample:=NewPerson, _
                    ObjectID:=CStr(RecordSet("MotherObjectID")))
    End If

' pick-up the Father object
    If Not IsNull(RecordSet("FatherObjectID")) Then
        Set pvtFather = _
            ObjectManager. _
                NewObject( _
                    Sample:=NewPerson, _
                    ObjectID:=CStr(RecordSet("FatherObjectID")))
    End If

' pick-up the Spouse object
    If Not IsNull(RecordSet("SpouseObjectID")) Then
        Set pvtSpouse = _
            ObjectManager. _
                NewObject( _
                    Sample:=NewPerson, _
                    ObjectID:=CStr(RecordSet("SpouseObjectID")))
    End If

    Set ObjectInitializeFromRecordSet = Me
End Function


Public Function ObjectInitializeRecordSet(Optional RecordSet As Variant) As Long
' Populate the RecordSet with my variables.
'   Do not initialize the ObjectID column.
'   Return any error code encountered.
'   (in support of VBOFCollection)

    On Local Error GoTo InitializeRecordSet_SetError
    Err = 0

    RecordSet("CustomerNumber") = CustomerNumber
    RecordSet("FirstName") = FirstName
    RecordSet("LastName") = LastName
    RecordSet("SSN") = SSN
    RecordSet("Sex") = Sex
    If DateOfBirth = #1/1/01# Then
        RecordSet("DateOfBirth") = Null
    Else
        RecordSet("DateOfBirth") = Format$(DateOfBirth, "mm/dd/yyyy")
    End If
    If DateOfDeath = #1/1/01# Then
        RecordSet("DateOfDeath") = Null
    Else
        RecordSet("DateOfDeath") = Format$(DateOfDeath, "mm/dd/yyyy")
    End If
    RecordSet("MaritalStatus") = MaritalStatus
    RecordSet("MaidenName") = MaidenName

' set the Mother object
    If Not pvtMother Is Nothing Then
        RecordSet("MotherObjectID") = _
            pvtMother.ObjectID
    Else
        RecordSet("MotherObjectID") = Null
    End If

' set the Father object
    If Not pvtFather Is Nothing Then
        RecordSet("FatherObjectID") = _
            pvtFather.ObjectID
    Else
        RecordSet("FatherObjectID") = Null
    End If

' set the Spouse object
    If Not pvtSpouse Is Nothing Then
        RecordSet("SpouseObjectID") = _
            pvtSpouse.ObjectID
    Else
        RecordSet("SpouseObjectID") = Null
    End If

' Note:  Do not initialize the ObjectID column.

    GoTo InitializeRecordSet_SetError

InitializeRecordSet_SetError:
    ObjectInitializeRecordSet = Err
    Exit Function
End Function

Public Function ObjectDataSource() As String
' Return the Data Source with which this Class is associated
'   (in support of VBOFCollection)

    ObjectDataSource = "Persons"
End Function
Public Function ObjectNewInstanceOfMyClass() As Person
' Return a new instance of this class
'   (in support of VBOFCollection)

    Set ObjectNewInstanceOfMyClass = New Person
End Function


Public Function ObjectEventCallBack(Optional Event As Variant, Optional Object As Variant) As Long
' Receive the Trigger notification and process
'   accordingly
'
' Parameters:
'   Event
'       a string which identifies the Event
'       Example: "Changed", "Created", "Deleted"
'   Object
'       the object originating the Event.
'       responds to:
'           TypeName(TriggerObject)
'           TriggerObject.ObjectID
' (supported by VBOFEventManager)

End Function




Public Function AddAddress(Optional Item As Variant, Optional Parent As Variant) As Address
' Return an Address, added to my pvtAddressesCollection
'   (just a wrapper method for Addresses.Add)

    Set AddAddress = Me.Addresses.Add( _
        Item:=Item, _
        Parent:=Me)

    ObjectHasChanged
End Function


Public Function Addresses(Optional ObjectID As Variant) As Variant
' Returns a VBOFCollection of Address objects which are
'   contained by this Person object,
' or
' Returns an Address object whose ObjectID matches the ObjectID
'   parameter.

    Dim tempNewAddress As New Address

    Set Addresses = _
        ObjectManager. _
            ManageCollection( _
                ObjectID:=ObjectID, _
                Collection:=pvtAddressesCollection, _
                Parent:=Me, _
                Sample:=tempNewAddress)

End Function

Public Function Phones(Optional ObjectID As Variant) As Variant
' Returns a VBOFCollection of Phone objects which are
'   contained by this Person object,
' or
' Returns a Phone object whose ObjectID matches the ObjectID
'   parameter.

    Dim tempNewPhone As New Phone

    Set Phones = _
        ObjectManager. _
            ManageCollection( _
                ObjectID:=ObjectID, _
                Collection:=pvtPhonesCollection, _
                Parent:=Me, _
                Sample:=tempNewPhone)

End Function


Public Function FormattedName() As String

    Dim ReturnString As String

    If UCase$(Left$(Sex, 1)) = "M" Then
        ReturnString = "Mr. "
    ElseIf UCase$(Left$(Sex, 1)) = "F" Then
        ReturnString = "Ms. "
    End If

    If UCase$(Left$(Sex, 1)) = "F" _
    And UCase$(Left$(MaritalStatus, 1)) = "M" _
    Then
        ReturnString = "Mrs. "
    End If

    ReturnString = ReturnString & FirstName

    If MaidenName <> "" Then
        ReturnString = ReturnString & " (" & MaidenName & ")"
    End If

    FormattedName = ReturnString & " " & LastName
End Function


Private Sub Class_Initialize()

    CustomerNumber = -1
    FirstName = ""
    LastName = ""
    SSN = -1
    DateOfBirth = #1/1/01#
    DateOfDeath = #1/1/01#
    ObjectID = -1

    Set ObjectManager = Nothing
    Set pvtMother = Nothing
    Set pvtFather = Nothing
    Set pvtSpouse = Nothing
End Sub



Public Function Age() As Integer

    Dim tempDateOfDeath As Variant

    If DateOfBirth = "" _
    Or DateOfBirth = #1/1/01# _
    Then
        Age = 0
        Exit Function
    End If

    If DateOfDeath = "" _
    Or DateOfDeath = #1/1/01# _
    Then
        tempDateOfDeath = Now
    Else
        tempDateOfDeath = DateOfDeath
    End If

    Age = DateDiff("yyyy", DateOfBirth, tempDateOfDeath)
End Function


Public Property Get CustomerNumber() As Long
    CustomerNumber = pvtCustomerNumber
End Property

Public Property Let CustomerNumber(aLong As Long)
    pvtCustomerNumber = aLong
'    ObjectHasChanged
End Property

Public Property Get FirstName() As String
    FirstName = pvtFirstName
End Property

Public Property Let FirstName(aString As String)
    pvtFirstName = aString
'    ObjectHasChanged
End Property

Public Property Get LastName() As String
    LastName = pvtLastName
End Property

Public Property Get MaidenName() As String
    MaidenName = pvtMaidenName
End Property


Public Property Let LastName(aString As String)
    pvtLastName = aString
'    ObjectHasChanged
End Property

Public Property Let MaidenName(aString As String)
    pvtMaidenName = aString
'    ObjectHasChanged
End Property


Public Property Get SSN() As Long
    SSN = pvtSSN
End Property

Public Property Let SSN(aLong As Long)
    pvtSSN = aLong
'    ObjectHasChanged
End Property

Public Property Get Sex() As String
    Sex = pvtSex
End Property

Public Property Let Sex(aString As String)
    pvtSex = aString
'    ObjectHasChanged
End Property

Public Property Get DateOfBirth() As Variant
    DateOfBirth = pvtDateOfBirth
End Property

Public Property Get DateOfDeath() As Variant
    DateOfDeath = pvtDateOfDeath
End Property


Public Property Let DateOfBirth(aDate As Variant)
    pvtDateOfBirth = aDate
'    ObjectHasChanged
End Property

Public Property Let DateOfDeath(aDate As Variant)
    pvtDateOfDeath = aDate
'    ObjectHasChanged
End Property


Public Property Get MaritalStatus() As String
    MaritalStatus = pvtMaritalStatus
End Property

Public Property Let MaritalStatus(aString As String)
    pvtMaritalStatus = aString
'    ObjectHasChanged
End Property